home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / DDEPASCAL / DDE / !Balls64 / p / balls64
Text File  |  1992-04-30  |  17KB  |  585 lines
  1. (*
  2.  * Title:    balls64
  3.  * Purpose:  to demonstrate the use of the RISC OS library
  4.  *
  5.  * This application takes the balls64 program, which you may have seen and
  6.  * displays it in a window. We use a sprite to hold the display, and plot
  7.  * this sprite scaled to fit the current size of the window.
  8.  * Left-clicking on the icon will start the display and this can be
  9.  * "frozen/unfrozen" using the main menu. Since we are in a cooperative
  10.  * multi-tasking environment, we display a ball on every null event to
  11.  * avoid "hogging" the CPU
  12.  * 
  13.  *)
  14.  
  15. Program Balls64;
  16.  
  17. Label 9999;
  18.  
  19. #include "wimp.h"        (*  access to WIMP SWIs                      *)
  20. #include "wimpt.h"       (*  wimp task facilities                     *)
  21. #include "win.h"         (*  registering window handlers              *)
  22. #include "event.h"       (*  poll loops, etc                          *)
  23. #include "baricon.h"     (*  putting icon on icon bar                 *)
  24. #include "sprite.h"      (*  sprite operations                        *)
  25. #include "werr.h"        (*  error reporting                          *)
  26. #include "res.h"         (*  access to resources                      *)
  27. #include "resspr.h"      (*  sprite resources                         *)
  28. #include "flex.h"        (*  dynamic mem alloc from WIMP              *)
  29. #include "template.h"    (*  reading in template file                 *)
  30. #include "bbc.h"         (*  olde-style graphics routines             *)
  31. #include "colourtran.h"  (*  interface to colour translation module   *)
  32. #include "os.h"          (*  low-level RISCOS access                  *)
  33. #include "dbox.h"        (*  dialogue box handling                    *)
  34. #include "saveas.h"      (*  data export from dbox by icon dragging   *)
  35. #include "visdelay.h"    (*  show the hourglass for delay             *)
  36.  
  37. (* --- Conversion macros --- *)
  38. (* These macros convert between sprite coords and work area coords *)
  39.  
  40. #define balls64_Xtowork(x)  shl((x), 1)
  41. #define balls64_Ytowork(y)  shl((y), 2)
  42.  
  43. (* --- Sprite Constants --- *)
  44. #define SpriteFile   $0ff9
  45. #define SpriteWidth  610
  46. #define SpriteHeight 230
  47. #define SpriteMode    15
  48. #define SpriteSize   640*256 + size(sprite_header) + size(sprite_area)
  49.  
  50. (* --- Circle Constants --- *)
  51. #define Radius  64
  52. #define RadDiv2 shr(Radius, 1)
  53. #define Step    shr(Radius, 3)
  54.  
  55. (* --- Menu Entry Constants --- *)
  56. #define iconmenu_MInfo     1
  57. #define iconmenu_MSave     2
  58. #define iconmenu_MDisplay  3
  59. #define iconmenu_MFreeze   4
  60. #define iconmenu_MQuit     5
  61.  
  62. type spr_details =
  63.        record
  64.          area : sprite_area_ptr;
  65.          id : sprite_id
  66.        end;
  67.  
  68. type change_box_handle = ^change_box_ptr;
  69.      change_box_ptr = ^change_box;
  70.      change_box =
  71.        record
  72.          flag : integer;
  73.          box : wimp_box
  74.        end;
  75.  
  76. (* --- Program Globals --- *)
  77.  
  78. var my_sprite : spr_details;         (* sprite used for display      *)
  79.     displaywin_handle : wimp_w;      (* display window handle        *)
  80.     save_area : ^integer;            (* save area for sprite context *)
  81.  
  82.     displaying : boolean;            (* window on display?           *)
  83.     frozen : boolean;                (* window display frozen?       *)
  84.     xdivmult, ydivmult,
  85.     xmagmult, ymagmult : integer;    (* scale to fit window          *)
  86.     trans : array[0..255] of sprite_pixtrans;
  87.                                      (* colour translation table     *)
  88.  
  89.  
  90. (*************************** SPRITE CREATION *******************************)
  91.  
  92. procedure balls64_create_sprite(var my_sprite : spr_details);
  93.  
  94. var save_area_size : integer;
  95.     ptr : sprite_ptr;
  96.  
  97. begin
  98.   (* --- allocate our own sprite area to hold balls display --- *)
  99.  
  100.   if not flex_alloc(flex_ptr(address(my_sprite.area)), SpriteSize)
  101.     then werr(TRUE, 'Fatal error - failed to allocate store for sprite');
  102.   sprite_area_initialise(my_sprite.area, SpriteSize);
  103.   
  104.   (* --- create a sprite within that area --- *)
  105.  
  106.   wimpt_complain(sprite_create(my_sprite.area, 'balldisplay',
  107.                  sprite_nopalette, SpriteWidth, SpriteHeight, SpriteMode));
  108.   my_sprite.id.tag := sprite_id_name;
  109.   my_sprite.id.s.name := 'balldisplay';
  110.  
  111.   (* --- select the sprite and get a pointer to it (faster) --- *)
  112.  
  113.   wimpt_complain(sprite_select_rp(my_sprite.area, address(my_sprite.id), ptr));
  114.   my_sprite.id.tag := sprite_id_addr;
  115.   my_sprite.id.s.addr := ptr;
  116.     
  117.   (* --- establish save area size for sprite context and allocate it --- *)
  118.   (* --- also set save area's first word to zero to show it is not   --- *)
  119.   (* --- yet initialised                                             --- *)
  120.  
  121.   wimpt_complain(sprite_sizeof_spritecontext(my_sprite.area,
  122.                                              address(my_sprite.id),
  123.                                              save_area_size));
  124.   if not flex_alloc(flex_ptr(address(save_area)), save_area_size)
  125.     then werr(TRUE, 'Fatal error - failed to get store for sprite context');
  126.   save_area^ := 0;
  127. end;
  128.  
  129. (***************************** WINDOW HANDLING *****************************)
  130.  
  131. procedure balls64_create_displaywin(var handle : wimp_w);
  132.  
  133. var window : wimp_wind_ptr;
  134.  
  135. begin
  136.  
  137.   (* --- find template for our window and create a window from it --- *)
  138.     window := template_syshandle('ballswind');
  139.     wimp_create_wind(window, handle);
  140.  
  141. end;
  142.  
  143. procedure balls64_redo_window(r : wimp_redrawstr; more : integer);
  144.  
  145. var more_to_do : integer;
  146.     new_r : wimp_redrawstr;
  147.     factors : sprite_factors;
  148.     pixtrans : array[0..255] of sprite_pixtrans;
  149.  
  150. begin
  151.  
  152.   more_to_do := more;
  153.   new_r := r;
  154.   
  155.   (* --- ask how the WIMP is going to scale our sprite --- *)
  156.   wimp_readpixtrans(my_sprite.area, address(my_sprite.id),
  157.                     address(factors), address(pixtrans[0]));
  158.  
  159.   (* -- scale the factors according to current window size --- *)
  160.   factors.xdiv := factors.xdiv * xdivmult;
  161.   factors.ydiv := factors.ydiv * ydivmult;
  162.   factors.xmag := factors.xmag * xmagmult;
  163.   factors.ymag := factors.ymag * ymagmult;
  164.  
  165.   (* --- refresh the window's contents --- *)
  166.   while more_to_do <> 0
  167.     do begin
  168.          wimpt_complain(sprite_put_scaled(my_sprite.area,
  169.                                           address(my_sprite.id), 0,
  170.                                           r.box.x0, r.box.y0,
  171.                                           address(factors),
  172.                                           address(trans[0])));
  173.          wimp_get_rectangle(address(new_r), more_to_do);
  174.        end;
  175. end;
  176.  
  177. procedure balls64_redraw_window(handle : wimp_w);
  178.  
  179. var more : integer;
  180.     r : wimp_redrawstr;
  181.     winfo : wimp_winfo;
  182.  
  183. begin
  184.   
  185.   winfo.w := handle;
  186.   wimp_get_wind_info(address(winfo));
  187.  
  188.   (* --- establish factors by which to scale sprite from current --- *)
  189.   (* --- window size                                             --- *)
  190.   xdivmult := winfo.info.ex.x1 - winfo.info.ex.x0;
  191.   ydivmult := winfo.info.ex.y1 - winfo.info.ex.y0;
  192.   xmagmult := winfo.info.box.x1 - winfo.info.box.x0;
  193.   ymagmult := winfo.info.box.y1 - winfo.info.box.y0;
  194.   
  195.   (* --- do the redraw --- *)
  196.   r.w := handle;
  197.   wimp_redraw_wind(address(r), more);
  198.  
  199.   if (more <> 0)
  200.     then balls64_redo_window(r, more);
  201. end;
  202.  
  203. procedure balls64_update_window(r : wimp_redrawstr);
  204.  
  205. var new_r : wimp_redrawstr;
  206.     more : integer;
  207.  
  208. begin
  209.  
  210.   new_r := r;
  211.  
  212.   wimp_update_wind(address(new_r), more);
  213.   if (more <> 0)
  214.     then balls64_redo_window(new_r, more);
  215. end;
  216.  
  217. var old_x, old_y : integer;
  218.   
  219. procedure balls64_open_window(o : wimp_openstr_ptr);
  220.  
  221. begin
  222.   
  223.   (* --- force scroll offsets to 0, since the window always --- *)
  224.   (* --- represents the whole display                       --- *)
  225.   o^.x := 0;
  226.   o^.y := 0;
  227.  
  228.   wimp_open_wind(o);
  229.  
  230.   (* --- only do a redraw if the size of the window has changed --- *)
  231.   if (old_x <> (o^.box.x1 - o^.box.x0)) or
  232.      (old_y <> (o^.box.y1 - o^.box.y0))
  233.     then begin
  234.            balls64_redraw_window(o^.w);
  235.            old_x := o^.box.x1 - o^.box.x0;
  236.            old_y := o^.box.y1 - o^.box.y0;
  237.          end;
  238. end;  
  239.  
  240. procedure balls64_leftclickproc(i : wimp_i);
  241.  
  242. var state : wimp_wstate;
  243.     r : wimp_redrawstr;
  244.  
  245. begin
  246.  
  247.   if not displaying
  248.     then begin
  249.            (* --- open the window we created --- *)
  250.            wimpt_noerr(wimp_get_wind_state(displaywin_handle, address(state)));
  251.            state.o.behind := -1;  (* make sure it is opened in front *)
  252.            balls64_open_window(address(state.o));
  253.       
  254.            (* --- force a redraw of the whole window --- *)
  255.            r.w := displaywin_handle;
  256.            r.box.x0 := 0;
  257.            r.box.x1 := balls64_Xtowork(SpriteWidth);
  258.            r.box.y0 := -balls64_Ytowork(SpriteHeight);
  259.            r.box.y1 := 0;
  260.            wimp_force_redraw(address(r));
  261.            displaying := TRUE;
  262.          end;
  263. end;
  264.  
  265. (************************** THE APPLICATION ITSELF *************************)
  266.  
  267. procedure balls64_changedbox(flag : integer; cbox : change_box_handle);
  268.  
  269. var e : error;
  270.  
  271. begin
  272.   swi('OS_ChangedBox', [0], flag; [1], cbox^);
  273. end;
  274.  
  275. function rand : integer; extern;
  276.  
  277. const RAND_MAX = $7fffffff;
  278.  
  279. function balls64_rnd(v : integer) : integer;
  280.  
  281. begin
  282.   balls64_rnd := trunc((rand / RAND_MAX) * v) + 1
  283. end;
  284.  
  285. function balls64_fnx : integer;
  286.  
  287. begin
  288.   balls64_fnx := balls64_rnd(balls64_Xtowork(SpriteWidth))
  289. end;
  290.  
  291. function balls64_fny : integer;
  292.  
  293. begin
  294.   balls64_fny := balls64_rnd(balls64_Ytowork(SpriteHeight))
  295. end;
  296.  
  297. function balls64_fnrgb : integer;
  298.  
  299. begin
  300.   balls64_fnrgb := (balls64_rnd(3)-1)*1 + 
  301.                    (balls64_rnd(3)-1)*4 + 
  302.                    (balls64_rnd(3)-1)*16
  303. end;
  304.  
  305. procedure balls64_do_ball;
  306.  
  307. var state : sprite_state;
  308.     r : wimp_redrawstr;
  309.     cbox : change_box_ptr;
  310.     l : real;
  311.     t, x : integer;
  312.     base : integer;
  313.     orgx, orgy : integer;
  314.  
  315. begin
  316.  
  317.   (* --- redirect VDU output to the sprite saving old state --- *)
  318.   wimpt_complain(sprite_outputtosprite(my_sprite.area, 
  319.                                        address(my_sprite.id),
  320.                                        save_area, 
  321.                                        address(state)));
  322.   (* --- enable checking changes to the "screen" (really our sprite) --- *)
  323.   balls64_Changedbox(1, address(cbox));
  324.   balls64_Changedbox(2, address(cbox));
  325.  
  326.   orgx := balls64_fnx;
  327.   orgy := balls64_fny;
  328.   l := ln(512/Radius)/ln(2);
  329.   base := balls64_fnrgb;
  330.   x := Radius;
  331.   while x >= Step
  332.     do begin
  333.          t := trunc(l);
  334.          bbc_vduq(23, 17, 2, 512-shl(x, t), 0, 0, 0, 0, 0);
  335.          if x <= RadDiv2
  336.            then bbc_gcol(0, base+$15)
  337.            else bbc_gcol(0,base);
  338.          bbc_move(orgx - x div 3,orgy - x div 3);
  339.          bbc_plot($9D, orgx+x, orgy);
  340.          x := x - Step;
  341.        end;
  342.  
  343.   (* --- see what's changed on the "screen" (ie. our sprite) --- *)
  344.   balls64_Changedbox(-1, address(cbox));
  345.  
  346.   r.w := displaywin_handle;
  347.   r.box.x0 := balls64_Xtowork(cbox^.box.x0) * xmagmult div xdivmult
  348.                - balls64_Xtowork(1);
  349.   r.box.x1 := balls64_Xtowork(cbox^.box.x1) * xmagmult div xdivmult
  350.                + balls64_Xtowork(1);
  351.   r.box.y0 := balls64_Ytowork(cbox^.box.y0 - SpriteHeight)
  352.                * ymagmult div ydivmult - balls64_Ytowork(1);
  353.   r.box.y1 := balls64_Ytowork(cbox^.box.y1 - SpriteHeight)
  354.                * ymagmult div ydivmult + balls64_Ytowork(1);
  355.     
  356.   (* --- restore output back to the VDU screen --- *)
  357.   wimpt_complain(sprite_restorestate(state));
  358.   
  359.   (* --- update the window contents --- *)
  360.   balls64_update_window(r);
  361. end;
  362.      
  363. (****************************** EVENT HANDLING *****************************)
  364.  
  365. var bpp_reported : boolean;
  366.  
  367. procedure balls64_bpp_warn;
  368.  
  369. begin
  370.   if not bpp_reported
  371.     then begin
  372.            werr(FALSE, 'Warning: I only look my best in 8-bpp modes');
  373.            bpp_reported := TRUE;
  374.          end;
  375. end;
  376.  
  377. procedure balls64_handler(e : wimp_eventstr_ptr; handle : pointer);
  378.  
  379. begin
  380.  
  381.   case e^.e of
  382.     wimp_ENULL:
  383.       if not frozen and displaying
  384.         then balls64_do_ball;
  385.  
  386.     wimp_EREDRAW:
  387.       balls64_redraw_window(e^.data.o.w);
  388.  
  389.     wimp_EOPEN:
  390.       balls64_open_window(address(e^.data.o));
  391.  
  392.     wimp_ECLOSE:
  393.       begin
  394.         wimpt_noerr(wimp_close_wind(e^.data.o.w));
  395.         displaying := FALSE;
  396.       end;
  397.  
  398.     wimp_ESEND,
  399.     wimp_ESENDWANTACK:     (* 
  400.                             * this code checks for mode/palette
  401.                             * broadcasts
  402.                             *)
  403.       case e^.data.msg.hdr.action of
  404.         wimp_PALETTECHANGE:
  405.           wimpt_complain(colourtran_select_table(SpriteMode,
  406.                          nil, -1,
  407.                          wimp_paletteword_ptr(-1), address(trans)));
  408.  
  409.         wimp_MMODECHANGE:
  410.           begin
  411.             wimpt_checkmode;
  412.             if wimpt_bpp <> 8
  413.               then balls64_bpp_warn;
  414.             wimpt_complain(colourtran_select_table(SpriteMode,
  415.                           nil, -1,
  416.                           wimp_paletteword_ptr(-1), address(trans)));
  417.           end;
  418.           
  419.  
  420.         wimp_MHELPREQUEST:
  421.           begin
  422.             e^.data.msg.hdr.your_ref := e^.data.msg.hdr.my_ref;
  423.             e^.data.msg.hdr.action := wimp_MHELPREPLY;
  424.             e^.data.msg.hdr.size := 256;
  425.             if e^.data.msg.helprequest.m.i = -1 (*ie. not on our icon*)
  426.               then e^.data.msg.helpreply.text :=
  427.                     'This is the balls64 display.|MOnly one can be active'
  428.               else e^.data.msg.helpreply.text :=
  429.                     'This is the balls64 icon.|MClick SELECT to start display';
  430.             wimpt_noerr(wimp_sendmessage(wimp_ESEND, address(e^.data.msg),
  431.                                          e^.data.msg.hdr.task));
  432.           end;
  433.     end;
  434.  
  435.   end;
  436. end;
  437.  
  438. procedure balls64_info_aboutprog;
  439.  
  440. var d : dbox;
  441.  
  442. begin
  443.  
  444.   (* --- display info about the program in a dialogue box --- *)
  445.   d := dbox_new('ProgInfo');
  446.  
  447.   dbox_showstatic(d);
  448.  
  449.   dbox_fillin(d);
  450.  
  451.   dbox_dispose(d);
  452. end;
  453.  
  454. function balls64_saver(filename : string; handle : pointer) : boolean;
  455.  
  456. var e : error;
  457.  
  458. begin
  459.  
  460.   (* --- save the sprite area in a sprite file --- *)
  461.   visdelay_begin;
  462.   e := wimpt_complain(sprite_area_save(my_sprite.area, filename));
  463.   visdelay_end;
  464.  
  465.   balls64_saver := not e;
  466. end;
  467.    
  468. (******************************* MENU HANDLING *****************************)
  469.  
  470. function balls64_menumaker(handle : pointer) : menu;
  471.  
  472. var temp : menu;
  473.  
  474. begin
  475.  
  476.   (* --- create a menu for the icon on the icon bar --- *)
  477.   temp := menu_new('Balls64', '>Info,>Save,Display,Freeze,Quit');
  478.  
  479.   (* --- fade out "start" field if we already have balls on display --- *)
  480.   menu_setflags(temp, iconmenu_MDisplay, false, displaying);
  481.  
  482.   (* --- tick/untick "freeze" appropriately --- *)
  483.   menu_setflags(temp, iconmenu_MFreeze, frozen, false); 
  484.  
  485.   balls64_menumaker := temp
  486. end;
  487.  
  488. procedure balls64_menuproc(handle : pointer; hit : event_hitstr_ptr);
  489.  
  490. begin
  491.   (* --- see which menu entry has been chosen --- *)
  492.   case integer(hit^[0]) of
  493.     iconmenu_MInfo:
  494.       balls64_info_aboutprog;
  495.  
  496.     iconmenu_MDisplay:
  497.         balls64_leftclickproc(wimp_i(0));
  498.  
  499.     iconmenu_MSave:
  500.         saveas(SpriteFile, 'BallsDump', SpriteSize,
  501.                balls64_saver, nil, nil, nil);
  502.  
  503.     iconmenu_MFreeze:
  504.       if (frozen)
  505.         then begin
  506.                event_setmask(uand(event_getmask, unot(wimp_EMNULL)));
  507.                frozen := FALSE;
  508.              end
  509.         else begin           
  510.                event_setmask(uor(event_getmask, wimp_EMNULL));
  511.                frozen := TRUE;
  512.              end;
  513.  
  514.     iconmenu_MQuit:
  515.         goto 9999;
  516.  
  517.   end;
  518. end;
  519.  
  520. (******************************** INITIALISATION ***************************)
  521.  
  522. procedure balls64_initialise;
  523.  
  524. begin
  525.   (* --- initialise wimp library modules --- *)
  526.   wimpt_init('balls64');
  527.   res_init('balls64');
  528.   resspr_init;
  529.   flex_init;
  530.   template_init;
  531.   dbox_init;
  532.  
  533.   (* --- check which mode we are in --- *)
  534.   wimpt_checkmode;
  535.   if (wimpt_bpp <> 8)
  536.     then balls64_bpp_warn;
  537.  
  538.   (* --- create sprite to be used as output --- *)
  539.   balls64_create_sprite(my_sprite);
  540.  
  541.   (* --- create a window for display --- *)
  542.   balls64_create_displaywin(displaywin_handle);
  543.  
  544.   (* --- attach an event handling function to window --- *)
  545.   win_register_event_handler(displaywin_handle, balls64_handler, nil);
  546.  
  547.   (* --- make the window we just created get delivered null events --- *)
  548.   (* --- and also unknown events (ie. msgs for palette/mode change --- *)
  549.   win_claim_idle_events(displaywin_handle);
  550.   win_claim_unknown_events(displaywin_handle);
  551.  
  552.   (* --- put our icon on the icon bar --- *)
  553.   baricon('!balls64', integer(resspr_area), balls64_leftclickproc);
  554.  
  555.   (* --- attach a menu to the icon on the icon bar --- *)
  556.   event_attachmenumaker(win_ICONBAR, balls64_menumaker, balls64_menuproc, nil);
  557.  
  558.   (* --- read the palette --- *)
  559.   wimpt_complain(colourtran_select_table(SpriteMode,nil,-1,
  560.                            wimp_paletteword_ptr(-1),address(trans)));
  561.  
  562.   (* --- activate saving of floating point registers on poll --- *)
  563.   wimp_save_fp_state_on_poll;
  564. end;
  565.  
  566. (******************************* MAIN PROGRAM ******************************)
  567.  
  568. begin
  569.   old_x := 0;
  570.   old_y := 0;
  571.   displaying := false;
  572.   frozen := false;
  573.   bpp_reported := false;
  574.   (* --- initialise the environment --- *)
  575.   balls64_initialise;
  576.  
  577.   (* --- mask off the events we're not interested in --- *)
  578.   event_setmask(uor(wimp_EMPTRENTER, wimp_EMPTRLEAVE));
  579.  
  580.   (* --- the main event loop --- *)   
  581.   while(TRUE)
  582.     do event_process;
  583.   9999:;
  584. end.
  585.